home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol146 / xlstr.c < prev    next >
Encoding:
C/C++ Source or Header  |  1986-12-16  |  3.3 KB  |  140 lines
  1. /* xlstr - xlisp string builtin functions */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. /* external variables */
  9. extern NODE *xlstack;
  10.  
  11. /* external procedures */
  12. extern char *strcat();
  13.  
  14. /* xstrcat - concatenate a bunch of strings */
  15. NODE *xstrcat(args)
  16.   NODE *args;
  17. {
  18.     NODE *oldstk,val,*p;
  19.     char *str;
  20.     int len;
  21.  
  22.     /* create a new stack frame */
  23.     oldstk = xlsave(&val,NULL);
  24.  
  25.     /* find the length of the new string */
  26.     for (p = args, len = 0; p; )
  27.     len += strlen(xlmatch(STR,&p)->n_str);
  28.  
  29.     /* create the result string */
  30.     val.n_ptr = newnode(STR);
  31.     val.n_ptr->n_str = str = stralloc(len);
  32.     *str = 0;
  33.  
  34.     /* combine the strings */
  35.     while (args)
  36.     strcat(str,xlmatch(STR,&args)->n_str);
  37.  
  38.     /* restore the previous stack frame */
  39.     xlstack = oldstk;
  40.  
  41.     /* return the new string */
  42.     return (val.n_ptr);
  43. }
  44.  
  45. /* xsubstr - return a substring */
  46. NODE *xsubstr(args)
  47.   NODE *args;
  48. {
  49.     NODE *oldstk,arg,src,val;
  50.     int start,forlen,srclen;
  51.     char *srcptr,*dstptr;
  52.  
  53.     /* create a new stack frame */
  54.     oldstk = xlsave(&arg,&src,&val,NULL);
  55.  
  56.     /* initialize */
  57.     arg.n_ptr = args;
  58.     
  59.     /* get string and its length */
  60.     src.n_ptr = xlmatch(STR,&arg.n_ptr);
  61.     srcptr = src.n_ptr->n_str;
  62.     srclen = strlen(srcptr);
  63.  
  64.     /* get starting pos -- must be present */
  65.     start = xlmatch(INT,&arg.n_ptr)->n_int;
  66.  
  67.     /* get length -- if not present use remainder of string */
  68.     forlen = (arg.n_ptr ? xlmatch(INT,&arg.n_ptr)->n_int : srclen);
  69.  
  70.     /* make sure there aren't any more arguments */
  71.     xllastarg(arg.n_ptr);
  72.  
  73.     /* don't take more than exists */
  74.     if (start + forlen > srclen)
  75.     forlen = srclen - start + 1;
  76.  
  77.     /* if start beyond string -- return null string */
  78.     if (start > srclen) {
  79.     start = 1;
  80.     forlen = 0; }
  81.     
  82.     /* create return node */
  83.     val.n_ptr = newnode(STR);
  84.     val.n_ptr->n_str = dstptr = stralloc(forlen);
  85.  
  86.     /* move string */
  87.     for (srcptr += start-1; forlen--; *dstptr++ = *srcptr++)
  88.     ;
  89.     *dstptr = 0;
  90.  
  91.     /* restore the previous stack frame */
  92.     xlstack = oldstk;
  93.  
  94.     /* return the substring */
  95.     return (val.n_ptr);
  96. }
  97.  
  98. /* xstring - return a string consisting of a single character */
  99. NODE *xstring(args)
  100.   NODE *args;
  101. {
  102.     NODE *oldstk,val;
  103.     char *p;
  104.     int ch;
  105.  
  106.     /* get the character (integer) */
  107.     ch = xlmatch(INT,&args)->n_int;
  108.     xllastarg(args);
  109.  
  110.     /* make a one character string */
  111.     oldstk = xlsave(&val,NULL);
  112.     val.n_ptr = newnode(STR);
  113.     val.n_ptr->n_str = p = stralloc(1);
  114.     *p++ = ch; *p = '\0';
  115.     xlstack = oldstk;
  116.  
  117.     /* return the new string */
  118.     return (val.n_ptr);
  119. }
  120.  
  121. /* xchar - extract a character from a string */
  122. NODE *xchar(args)
  123.   NODE *args;
  124. {
  125.     char *str;
  126.     int n;
  127.  
  128.     /* get the string and the index */
  129.     str = xlmatch(STR,&args)->n_str;
  130.     n = xlmatch(INT,&args)->n_int;
  131.     xllastarg(args);
  132.  
  133.     /* range check the index */
  134.     if (n < 0 || n >= strlen(str))
  135.     xlerror("index out of range",cvfixnum((FIXNUM)n));
  136.  
  137.     /* return the character */
  138.     return (cvfixnum((FIXNUM)str[n]));
  139. }
  140.